#lang racket


(require "../ast/main.rkt"
         "../base/main.rkt")

(require "shape.rkt")

(provide evaluator-visitor%)


;(define-syntax (define-visit-method stx)
;  (syntax-case stx (proxy)
;    ((ctx proxy name (field ...))
;     (let ((method-name (datum->syntax #'ctx (string->symbol (format "visit-~A" (syntax->datum #'name))))))
;       #`(define/public (#,method-name node)
;           (send
;            proxy
;            name
;            #,@(map
;                (λ (stx)
;                  (let ((dat (syntax->datum stx)))
;                    (if (symbol? dat)
;                        #`(get-field #,stx node)
;                        #`(send this evaluate (get-field #,(datum->syntax #'ctx (cadr dat)) node)))))
;                (syntax-e #'(field ...)))))))))

(define evaluator-visitor%
  (class* object% (visitor%)
    (super-new)
    
    (init-field backend)
    
    
    ; node? -> listof shape?
    (define cached-shapes (make-hasheq))
    
    (define (add-cached-shapes node shape)
      (let ((shapes (hash-ref cached-shapes node (list))))
        (hash-set! cached-shapes node (cons shape shapes))
        shape))
    
    (define/public (get-cached-shapes)
      (flatten (hash-values cached-shapes)))
    
    (define (associate node shape)
      (set-shape-backend! shape backend)
      (set-shape-node! shape node)
      (add-cached-shapes node shape)
      shape)
    
    (define/public (shape<-id id)
      (for/or (((node shapes) (in-hash cached-shapes)))
        (findf (λ (shape) (equal? (shape-id shape) id)) shapes)))

    
    ; evaluate
    
    ; : node -> shape
    (define/public (evaluate node)
      (associate node (send node visit this)))

    
    ; points
    
    (define/public (visit-point node)
      (send
       backend
       point
       (get-field c node)))
    
    
    ; lines
    
    (define/public (visit-arc node)
      (send
       backend
       arc
       (get-field angle node)
       (get-field radius node)))
    
    (define/public (visit-elliptical-arc node)
      (send
       backend
       elliptical-arc
       (get-field angle node)
       (get-field x-radius node)
       (get-field y-radius node)))
    
    (define/public (visit-ellipse node)
      (send
       backend
       ellipse
       (get-field x-radius node)
       (get-field y-radius node)))
    
    (define/public (visit-line node)
      (send
       backend
       line
       (get-field closed? node)
       (get-field cs node)))
    
    (define/public (visit-nurbs-curve node)
      (send
       backend
       nurbs-curve
       (get-field controls node)
       (get-field knots node)))
    
    
    ; surfaces
    
    (define/public (visit-annulus node)
      (send
       backend
       annulus
       (get-field inner-radius node)
       (get-field outer-radius node)))
    
    (define/public (visit-ngon node)
      (send
       backend
       ngon
       (get-field width node)
       (get-field sides node)))
    
    (define/public (visit-nurbs-surface node)
      (send
       backend
       nurbs-surface
       (get-field controls node)
       (get-field u-knots node)
       (get-field v-knots node)))
    
    (define/public (visit-spline node)
      (send
       backend
       spline
       (get-field closed? node)
       (get-field cs node)
       (get-field type node)))
    
    (define/public (visit-star node)
      (send
       backend
       star
       (get-field width node)
       (get-field sides node)
       (get-field stride node)))
    
    (define/public (visit-surface node)
      (define (evaluate-with-cs expr)
        (if (is-a? expr node%)
            (send this evaluate expr)
            expr))
      
      (send
       backend
       surface
       (evaluate-with-cs (get-field node node))))
    
    
    ; solids
    
    (define/public (visit-box node)
      (send
       backend
       box
       (get-field width node)
       (get-field length node)
       (get-field height node)))
    
    (define/public (visit-cone node)
      (send
       backend
       cone
       (get-field radius node)
       (get-field height node)))
    
    (define/public (visit-cone-frustum node)
      (send
       backend
       cone-frustum
       (get-field base-radius node)
       (get-field top-radius node)
       (get-field height node)))
    
    (define/public (visit-cylinder node)
      (send
       backend
       cylinder
       (get-field radius node)
       (get-field height node)))
    
    (define/public (visit-pyramid node)
      (send
       backend
       pyramid
       (get-field width node)
       (get-field sides node)
       (get-field height node)))
    
    (define/public (visit-sphere node)
      (send
       backend
       sphere
       (get-field radius node)))
    
    
    ; generic shapes
    
    (define/public (visit-circle node)
      (send
       backend
       circle
       (get-field c node)
       (get-field type node)
       (get-field radius node)))
    
    (define/public (visit-rectangle node)
      (send
       backend
       rectangle
       (get-field type node)
       (get-field width node)
       (get-field length node)))
    
    
    ; text
    
    (define/public (visit-text node)
      (send
       backend
       text
       (get-field t node)
       (get-field r node)
       (get-field s node)
       (get-field str node)))
    
    
    ; transformations
    
    (define/public (visit-extrude node)
      (send
       backend
       extrude
       (get-field length node)
       (get-field dir node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-intersect node)
      (send
       backend
       intersect
       (send this evaluate (get-field node node))))
    
    (define/public (visit-join node)
      (send
       backend
       join
       (send this evaluate (get-field node node))))
    
    (define/public (visit-loft node)
      (send
       backend
       loft
       (get-field loft-type node)
       (get-field loft-fit-type node)
       (get-field closed? node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-move node)
      (send
       backend
       move
       (get-field c node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-offset node)
      (send
       backend
       offset
       (get-field distance node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-rotate node)
      (send
       backend
       rotate
       (get-field angle node)
       (get-field normal node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-scale node)
      (send
       backend
       scale
       (get-field type node)
       (get-field c node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-section node)
      (send
       backend
       section
       (get-field type node)
       (get-field plane node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-slice node)
      (send
       backend
       slice
       (send this evaluate (get-field node1 node))
       (send this evaluate (get-field node2 node))))
    
    (define/public (visit-subtract node)
      (send
       backend
       subtract
       (send this evaluate (get-field node node))))
    
    (define/public (visit-sweep node)
      (send
       backend
       sweep
       (send this evaluate (get-field path node))
       (send this evaluate (get-field node node))))
    
    (define/public (visit-thicken node)
      (send
       backend
       thicken
       (get-field distance node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-union node)
      (send
       backend
       union
       (send this evaluate (get-field node node))))
    
    
    ; lang
    
    (define/public (visit-align node)
      (send
       backend
       align
       (get-field key-align-types node)
       (send this evaluate (get-field key-shape node))
       (get-field shape-align-types node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-parametric node)
      (send
       backend
       parametric
       (get-field functional-par node)))
    
    (define/public (visit-lift node)
      (send
       backend
       lift
       (get-field proc node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-on node)
      (send
       backend
       on
       (get-field type node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-sequence node)
      (make-list-shape
       (for/list ((node (get-field nodes node)))
         (send this evaluate node))))
    
    
    ; cad
    
    (define/public (visit-layer node)
      (send
       backend
       layer
       (get-field name node)
       (send this evaluate (get-field node node))))
    
    (define/public (visit-view node)
      (send
       backend
       view
       (get-field type node)
       (get-field projection-type node)
       (get-field style node)
       (send this evaluate (get-field node node))))))